;;; Qire --- The Qi Remote Extension
;;;
;;; Copyright (C) 2020 Kevin "The Nuclear" Bloom <nuclearkev@dragora.org>
;;;
;;; This file is part of qire.
;;;
;;; Qire is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; Qire is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Qire.  If not, see <http://www.gnu.org/licenses/>.

;; Error Codes:
;; 0 - no config found
;; 1 - no repos
;; 3 - invalid command

(local view (include :fennelview))
(local lf (include :lispy-fennel))
(local str lf.str)
(local list lf.list)
(local tbl lf.tbl)
(local iter lf.iteration)

(local version "0.0.5")

(local help-text
  "Qire - Qi Remote Extension

   Usage: qire COMMAND [OPTIONS...] [ARGUMENTS...]
          qire install,downgrade,info [-r,--repo repo] [-l,--local] [-f,--force] pkg1 [pkgs...]
          qire upgrade,search [-r,--repo repo] [-l,--local] [-f,--force] [pkgs...]
          qire install,upgrade,downgrade [-r,--repo repo] [-f,--force] -c,--category category
          qire search [-l, --local] -c,--category category
          qire fetch [-r,--repo repo] [-o,--output-directory dir] pkg1 [pkgs...]
          qire fetch [-r,--repo repo] -c,--category category
          qire sync,build-index repo1 [repos...]
          qire remove pkg
          qire remove -c,--category category
          qire clean,version,help

   Remote/Local Comamnds:
   install                 Install packages from the repo(s) or local filesystem
   upgrade                 Upgrade installed packages from the repo(s) or local filesystem
   downgrade               Downgrade installed packages from the repo(s) or local filesystem
   search                  Search the repo(s) or local filesystem for a particular package
   info                    Display information on a package in the repo(s) or local filesystem

   Remote-Only Commands:
   sync                    Sync the local repo(s) tree
   fetch                   Fetch package from repo
   build-index             Build index files for repos in config

   Local-Only Commands:
   remove                  Remove installed packages
   clean                   Clean out the Qire cache directory

   Options:
   -c, --category          Supply a category name rather than a package name to an applicable command
   -f, --force             Force a command to be reran
   -l, --local             Run an applicable command locally
   -o, --output-directory  Choose a different output directory for fetched packages
   -r, --repo              Select which repo(s) you'd like to use

   Other Commands:
   version, --version      Display the version
   help, --help            Display this help information")

(local many-options
  [;; commands
   :install
   :sync
   :upgrade
   :downgrade
   :fetch
   :search
   :remove
   :info
   :build-index])

(local single-options
  [:-r :--repo
   :-o :--output-directory
   :-c :--category])

(local no-options
  [:clean
   :help
   :version
   :-h :--help
   :-v :--version
   :-l :--local
   :-f :--force])


(local etc/qire "/etc/qire/")
(local var/cache/qire "/var/cache/qire/")
(local graft-pkg-path
       (let [pipe (io.popen "qi -L | grep QI_PACKAGEDIR | cut -c 15-")
             pipe-data (pipe:read "*a")]
         (pipe:close)
         (..
          (str.take
           pipe-data
           -2)
          "/")))

(fn wget! [url output-file]
  (if output-file
    (os.execute (.. "wget -q --show-progress " url " -O " output-file))
    (let [p (io.popen (.. "wget -q --show-progress -O - " url))
          d (p:read "*a")]
      (p:close)
      d)))

;;; extract-tr :: HTML -> List String
(fn extract-tr [tb]
  (let [tr-pos (string.find tb "<tr")
        end-tr-pos (string.find tb "</tr>")]
    (if tr-pos
        (let [tr (string.sub tb tr-pos end-tr-pos)
              end-tr-pos-including-tr (+ end-tr-pos 5)
              a-href-pos (string.find tr "<a href=")
              end-a-pos (string.find tr "</a>")
              a (string.sub tr a-href-pos end-a-pos)
              href (. (str.split a "\"") 2)
              remaining (str.drop tb end-tr-pos-including-tr)]
          (if (or (string.find href ".tlz" -4)
                  (and (string.find href "/")
                       (not (= href "../"))))
            (list.append [href] (extract-tr remaining))
            (extract-tr remaining)))
        [])))

;;; find-package-txt :: HTML -> List String
(fn find-package-txt [file]
  (let [table-pos (string.find file "<tbody>")
        end-table-pos (string.find file "</tbody>")
        table (string.sub file table-pos end-table-pos)]
    (extract-tr table)))

(fn info-property [data prop]
  (if data
    (let [fir-pos (string.find data prop)]
      (if fir-pos
        (let [without (str.drop data fir-pos)
              end-pos (string.find without "\n")]
          (if end-pos
            (let [substring (str.take without end-pos)]
              (string.sub
               (str.drop
                substring
                (+ (length prop) 2))
               1
               -2))))))))

(fn get-txt-file-and-put [old-url url file-name repo-url]
  (print url)
  (let [full-tlz (list.last (str.split url "/"))
        list-tlz (list.reverse (str.split full-tlz "_"))
        path (str.drop old-url (length repo-url))]
    (if (< (length list-tlz) 3)
      (let [name (. (str.split full-tlz "%.") 1)
            meta-file-data (wget! (.. url ".txt"))
            after-name (. (str.split meta-file-data (.. "pkgname=" name)) 2)
            version (list.car
                     (str.split
                      (info-property after-name "pkgversion")
                      "\n"))
            arch (list.car
                     (str.split
                      (info-property after-name "arch")
                      "\n"))
            release (list.car
                       (str.split
                        (info-property after-name "release")
                        "\n"))
            cat (.
                 (str.split
                  (list.car
                   (str.split
                    (info-property after-name "pkgcategory")
                    "\n"))
                  "\"")
                 2)]
        (file-name:write
         (.. name "_"
             version "_"
             arch "-"
             release "@"
             cat ".tlz "
             path " "
             1 "\n")))
      (let [writeable-string (.. full-tlz " " path "\n")]
        (file-name:write writeable-string)))))

(fn check-for-dirs [maybe-dir url file-name repo-url]
  (let [new-url (.. url maybe-dir)]
    (if (string.find maybe-dir "/")
      ;; yes, a dir - go deeper!
        new-url
      ;; not a dir
      (get-txt-file-and-put url new-url file-name repo-url))))

(fn parse-html [page file-port repo-url]
  (let [html page.html
        url page.url
        package-txt (find-package-txt html)]
    (each [k v (ipairs package-txt)]
      (let [url? (check-for-dirs v url file-port repo-url)]
        (if (= (type url?) "string")
          (parse-html
           {:html (wget! url? nil)
            :url url?}
           file-port
           repo-url))
        nil))))

;; read-repo-list :: Either (List String, False) -> '(Repo-Id . Repo-Url)
;; (fn read-repo-list [only]
;;   "Reads the config and returns '(<id> . <url>)"
;;   (let [path (.. etc/qire "config")
;;         file (io.open path "r")
;;         file-data (file:read "*a")
;;         comments-removed (iter.filter
;;                           (fn [x]
;;                             (not (string.find x "#" 1)))
;;                           (str.split file-data "\n"))
;;         repo-strings (iter.filter
;;                       (fn [x]
;;                         (not (= "" x)))
;;                       (iter.map
;;                        (fn [x]
;;                          (if (string.find x "repo" 4)
;;                            (str.drop x 6)
;;                            x))
;;                        comments-removed))]
;;     (iter.filter-map
;;      (fn [x]
;;        (let [repo-cons (str.split x " ")
;;              id (. repo-cons 2)
;;              url (. repo-cons 3)
;;              make-repo-table (fn [cons] {:id id :url url})]
;;          (if only
;;            (if (tbl.find id only)
;;              (make-repo-table repo-cons))
;;            (make-repo-table repo-cons))))
;;      repo-strings)))

(fn read-config [only]
    "Reads the config and returns a tbl containing the default repos and the others.
   ONLY can be a list of Repo-Ids or a list containing `:all` to force all repos."
    (let [path (.. etc/qire "qirerc")
          file (io.open path "r")]
      (if file
          (let [file-data (file:read "*a")
                comments-removed (iter.filter
                                   (fn [x]
                                       (not (string.find x "#" 1)))
                                   (str.split file-data "\n"))
                default-list (iter.filter-map
                              (fn [x]
                                (if (and (not (= "" x))
                                         (string.find x "default" 1))
                                  (str.drop x 9)))
                              comments-removed)
                default-setting (if (list.empty? default-list)
                                  []
                                  (str.split
                                   (. default-list 1)
                                   " "))
                repo-strings (iter.filter-map
                               (fn [x]
                                 (if (and (not (= "" x))
                                          (string.find x "repo" 1))
                                       (str.drop x 6)))
                               comments-removed)
                create-repo-tbl (fn [rs]
                                    (iter.filter-map
                                     (fn [x]
                                         (let [repo-cons (str.split x " ")
                                               trimmed (iter.filter
                                                        (fn [s]
                                                          (not
                                                           (= s "")))
                                                        repo-cons)
                                               id (. trimmed 1)
                                               url (. trimmed 2)
                                               make-repo-table (fn [cons] {:id id :url url})]
                                           (make-repo-table trimmed)))
                                     rs))
                all-repos (create-repo-tbl repo-strings)
                filter-defaults (fn [rs f] (iter.filter f rs))
                default-repos (if (and only (= (list.car only) :all))
                                  all-repos
                                  only
                                  (filter-defaults
                                   all-repos
                                   #(tbl.find $1.id only))
                                  (= (list.car default-setting) "all")
                                  all-repos
                                  (filter-defaults
                                   all-repos
                                   #(tbl.find $1.id default-setting)))
                other-repos (if (and only (= (list.car only) :all))
                                []
                                only
                                (filter-defaults
                                 all-repos
                                 #(not (tbl.find $1.id only)))
                                (= (list.car default-setting) "all")
                                []
                                (filter-defaults
                                 all-repos
                                 #(not (tbl.find $1.id default-setting))))]
            (file:close)
            (when (list.empty? repo-strings)
              (print "Error 1: Config lacks repos."))
            {:default default-repos
             :other other-repos})
          (do (print "Error 0: No config file found!")
              {:default [] :other []}))))

;;; exhaustively-get-data :: List (List ID URL HTML) -> File-Name -> List String
(fn build-index! [only-repos out-dir]
  (let [output-dir (if out-dir
                     (if (string.find out-dir "/" -1)
                       out-dir
                       (.. out-dir "/"))
                     "./")
        repos-to-build (if (list.empty? only-repos)
                         [:all]
                         only-repos)
        config (read-config repos-to-build)
        repos config.default]
    (each [k repo (ipairs repos)]
      (let [index-name (.. output-dir repo.id ".index")
            file-port (io.open index-name "w+b")
            html (wget! repo.url nil)
            page {:html html :url repo.url}]
        (io.write (.. "Creating index for dragora-i586..."))
        (file-port:write "")
        (parse-html page file-port repo.url)
        (print (.. "Saved index to: " index-name))
        (file-port:close)))))

(fn extract-package-values [pkg-data]
  (let [pkg-list (str.split pkg-data " ")
        pkg-name (. pkg-list 1)
        version (. pkg-list 2)
        release (. pkg-list 3)
        arch (. pkg-list 4)
        path (. pkg-list 5)
        without-version? (. pkg-list 6)]
    {:pkg-name pkg-name
     :version version
     :release release
     :arch arch
     :path path
     :without-version? without-version?}))

(fn generate-full-tlz [pkg path?]
  "Returns the full .tlz file name for PKG. PKG must be of form: {:repo-id String :url Pkg-Data}.
Optionally returns the path if PATH? is `true`."
  (let [epkg (extract-package-values pkg)
        file-name (if epkg.without-version?
                    (.. epkg.pkg-name ".tlz")
                    (.. epkg.pkg-name "-"
                        epkg.version "-"
                        epkg.arch "+"
                        epkg.release ".tlz"))]
    (if path?
      {:tlz file-name :path epkg.path}
      file-name)))

(fn exact-compare-repo [pkg query]
  (let [pkg-name (list.car (str.split pkg "_"))]
    (= pkg-name query)))

(fn exact-compare-cat [pkg query tlz?]
  (let [tlz (if tlz?
              ".tlz"
              "")
          split-by-at (str.split pkg "@")
        cat-name (when (= (length split-by-at) 2)
                   (list.car (str.split (. split-by-at 2) " ")))]
    ;; Not sure why but splitting by period "." and "\." doesn't work...
    (= cat-name (.. query tlz))))

;; Search-Type :: Either :lazy :exact
;; search-repo :: String -> Search-Type -> List ( (Repo-Id . Repo-Url) )
(fn search-repos [query search-type repos]
  "Search in REPOS for QUERY. Returns '(<index-file-name> . <pkg-data>) of type
   pair? of string? . string?"
  (list.flatten
   (iter.filter-map
    (fn [repo]
      (let [index-file-name (.. etc/qire repo.id ".index")
            file (io.open index-file-name "r")]
        (if file
          (let [file-data (file:read "*a")
                pkg-list (str.split file-data "\n")
                ;; due to lua's `string.find` being unable to work with '-${text}'
                q (if (and query (string.find query "-"))
                    (iter.reduce
                     (fn [acc elem]
                       (if (= acc "")
                         elem
                         (.. acc "%-" elem)))
                     ""
                     (str.split query "-"))
                    query)
                pkgs (iter.filter-map
                      (fn [x]
                          (let [contains? (if query
                                              (string.find x q)
                                              (not (= x "")))]
                            (if (and contains? (not query))
                                {:pkg x
                                 :repo-id repo.id}
                                (and contains? (= search-type :exact))
                                (let [exact? (exact-compare-repo x query)]
                                  (if exact?
                                      {:pkg x
                                       :repo-id repo.id}))
                                (and contains? (= search-type :category))
                                (let [exact? (exact-compare-cat x query true)]
                                  (if exact?
                                      {:pkg x
                                       :repo-id repo.id}))
                                contains?
                                {:pkg x
                                 :repo-id repo.id})))
                      pkg-list)]
            (if (and pkgs (not (list.empty? pkgs)))
              pkgs))
          (print (.. "No index file found for " repo.id ". Use `qire sync` to sync down the latest package tree.")))))
    repos)))


(fn try-all-repos [config func]
  "CONFIG is the table returned from `read-config` and FUNC is a partially applied
   function who's last argument must be a list of repos.

   This function will attempt all repos starting with the defaults."
  (let [defaults config.default
        others config.other]
    (if (not
         (and (list.empty? defaults)
                (list.empty? others)))
      (let [found (func defaults)]
        (if (list.empty? found)
          (do (print
               "Found no results in default repos.")
              (let [others-found (func others)]
                (if (list.empty? others-found)
                    (print "Found no results in other repos.")
                    found)))
          found)))))

;; search-repo! :: String -> Either (List String, False) -> IO ()
(fn search-repos! [query only-repos search-type]
  "Search the repo indexes for QUERY. This will find the first package with
   QUERY in the pkgname. Optionally, specify which repo you'd like to search via
   ONLY-REPO, which is of type `list?` of `string?`. SEARCH-TYPE is only set when
   searching via category and is usually set to :category."
  (let [config (read-config only-repos)
        s-type (if search-type
                   search-type
                   :lazy)
        pkgs (try-all-repos
              config
              (partial search-repos query s-type))]
    (when pkgs
      (each [k pkg (ipairs pkgs)]
        (when (not (= pkg.pkg ""))
          (let [name (list.car (str.split pkg.pkg " "))]
            (print
             (.. name
                 " from <"
                 pkg.repo-id
                 ">"))))))))

;; CANNOT TEST THIS UNTIL THERE IS AN INDEX AVAILABLE!
;; sync-repos! :: Either (List String, False) -> IO ()
(fn sync-repos! [only-repos]
  "Find repos in config and fetch their `packages.index` files. Saves each found
   index under `<repo-id>.index`."
  (let [repos-to-build (if (list.empty? only-repos)
                         [:all]
                         only-repos)
        config (read-config repos-to-build)
        repos config.default]
    (each [k repo (ipairs repos)]
      (do
        (print (.. "Updating " repo.id "..."))
        (let [path etc/qire
              url-index (.. repo.url "packages.index")
              index-name (.. path repo.id ".index")]
          (wget! url-index index-name) ;file called <repo-id>.index
          (print "Success!"))))))

(fn parse-installed [pkg]
  (let [split-list (str.split pkg "_")]
    (if (> (length split-list) 1)
      (let [[arch back] (str.split (list.last split-list) "-")
            [release cat] (str.split back "@")
            version (. split-list 2)
            pkg-name (. split-list 1)]
        {:full pkg
         :pkg-name pkg-name
         :version version
         :arch arch
         :release release
         :cat cat})
      ;; lacks version in tlz name
      (let [file (io.open (.. graft-pkg-path pkg "/var/lib/qi/" pkg ".txt") "r")
            file-data (file:read "*a")]
        (file:close)
        (let [after-name (. (str.split file-data "pkgname=") 2)
              pkg-name (info-property after-name "pkgname")
              version (info-property after-name "pkgversion")
              arch (info-property after-name "arch")
              release (info-property after-name "release")
              cat (info-property after-name "pkgcategory")]
          {:full pkg
           :pkg-name pkg
           :version version
           :arch arch
           :release release
           :cat cat})))))

(fn exact-compare-installed [pkg query]
  (let [p (parse-installed pkg)]
    (= p.pkg-name query)))

;; search-installed :: String -> Search-Type -> List ( (Pkg-Dir . Pkg-Name) )
(fn search-installed [query search-type]
  "Search in `graft-pkg-path` for PKG-NAME. Returns all matches in the form
   '(<pkg-dir> . <pkg-name>)."
  (let [pipe (io.popen (.. "ls " graft-pkg-path))
        pkgs (pipe:read "*a")
        pkgs-list (str.split pkgs "\n")
        q (if (and query (string.find query "-"))
              (iter.reduce
               (fn [acc elem]
                 (if (= acc "")
                     elem
                     (.. acc "%-" elem)))
               ""
               (str.split query "-"))
              query)]
    (pipe:close)
    (iter.filter-map
     (fn [pkg]
         (let [contains? (if query
                             (string.find pkg q)
                             (not (= pkg "")))
               found? (if (and contains? (not query))
                          true
                      (and contains? (= search-type :exact))
                      (exact-compare-installed pkg query)
                      (and contains? (= search-type :category))
                      (exact-compare-cat pkg query false)
                      contains?)]
         (if found?
           (.. graft-pkg-path pkg))))
     pkgs-list)))

;; search-installed! :: String -> IO ()
(fn search-installed! [pkg-name search-type]
  "Search for PKG-NAME using SEARCH-INSTALLED. Prints out locations."
  (let [matches (search-installed pkg-name search-type)]
    (if (and (= search-type :lazy)
             (list.empty? matches))
      (print "Package not installed.")
      (and (= search-type :category)
             (list.empty? matches))
      (print (.. "No packages found in category: " pkg-name))
      (each [k pkg (ipairs matches)]
       (print
        (.. "Package found at: " pkg))))))

(fn select-installed-match [query matches]
  (print (.. "Found multiple matches of '"
             query
             "', select which package:"))
  (each [idx pkg (ipairs matches)]
    (print
     (..
        "[" idx "] " pkg)))
  (io.write
   (..
    "[1-" (length matches) "/n]: "))
  (io.flush)
  (let [selection-string (io.read 1)
        selection (tonumber selection-string)]
    (if (and selection
             (>= selection 1)
             (<= selection (length matches)))
      (do
        (io.read 1)
        (. matches selection)))))

;; remove-packages! :: String -> IO ()
(fn remove-packages! [pkg-names search-type]
  "Search for PKG-NAMES and delete them using qi."
   (let [pkgs (if (= search-type :exact)
                  (iter.filter-map
                    (fn [x]
                        (let [pkgs (search-installed x search-type)]
                          (if (list.empty? pkgs)
                              (print (.. "No package found with by name: " x))
                              (> (length pkgs) 1)
                              (select-installed-match x pkgs)
                              (. pkgs 1))))
                    pkg-names)
                  (let [category (. pkg-names 1)
                        pkgs (search-installed category search-type)]
                    (if (list.empty? pkgs)
                        (do (print (.. "No package found with in category: " category))
                            [])
                        pkgs)))]
    (when (not (list.empty? pkgs))
      (do
        (each [k pkg (ipairs pkgs)]
          (print pkg))
       (io.write "Delete the above packages? [Y/n]: ")
       (io.flush)
       (when (tbl.find (io.read 1) ["Y" "y" "\n"])
         (each [k pkg (ipairs pkgs)]
           (os.execute
            (.. "qi remove " pkg))))))))

(fn generate-path [pkg config method]
  "Build the full package .tlz name and path on the repo."
  (let [repos (list.append config.default config.other)
        [tlz path no-version] (str.split pkg.pkg " ")
        repo (. (iter.filter
                (fn [repo]
                  (= pkg.repo-id repo.id))
                repos)
                1)
        without-tlz (str.take tlz -5)] ;remove the ".tlz"
    (if (or (= :Upgrade method) (= :Downgrade method))
      (let [ipkg pkg.ipkg
            installed-file-tlz ipkg.full]
        (io.write
         (..
          installed-file-tlz
          " -> "
          without-tlz
          " from <"
          pkg.repo-id
          ">\n")))
      (io.write
       (..
        without-tlz
        " from <"
        pkg.repo-id
        ">\n")))
    (if no-version
      (let [pkg-name (list.car (str.split tlz "_"))]
        {:tlz (.. pkg-name ".tlz")
         :url (.. repo.url path pkg-name ".tlz")})
      {:tlz tlz
       :url (.. repo.url path tlz)})))

(fn select-match [query matches]
  (print (.. "Found multiple matches of '"
             query
             "', select which package:"))
  (each [idx pkg-tbl (ipairs matches)]
    (let [name (list.car (str.split pkg-tbl.pkg " "))]
      (print
       (..
        "[" idx "] " name " from <" pkg-tbl.repo-id ">"))))
  (io.write
   (..
    "[1-" (length matches) "/n]: "))
  (io.flush)
  (let [selection-string (io.read 1)
        selection (tonumber selection-string)]
    (if (and selection
             (>= selection 1)
             (<= selection (length matches)))
      (do
        (io.read 1)
        (. matches selection)))))

;; TODO: qi update
(fn multiple-n-grade-options [pkg-name ipkgs]
  (print (..
          "Multiple installed versions of "
          pkg-name
          ", select which to take action: "))
  (each [idx ipkg (ipairs ipkgs)]
    (print
     (..
      "[" idx "] " ipkg.full)))
  (io.write
   (..
    "[1-" (length ipkgs) "/n]: "))
  (io.flush)
  (let [selection-string (io.read 1)
        selection (tonumber selection-string)]
    (if (and selection
             (>= selection 1)
             (<= selection (length ipkgs)))
      (do
        (io.read 1)
        (. ipkgs selection)))))

(fn n-grade-logic [method matched]
  "Logic for upgrading/downgrading. Since they're basically the same. MATCHED must
   be a table returned from `select-match`. Returns MATCHED with an `ipkg` table
   attached to it. (ipkg is returned from `parse-installed`)"
  (let [pkg-list (str.split matched.pkg "_")
        pkg-name (list.car pkg-list)
        pkg-version (. pkg-list 2)
        ipkg-strings (search-installed pkg-name :exact)
        up-or-down (match method
                    :Upgrade
                    {:past-tense "upgraded"
                     :compare #(< $1 $2)
		     :already (.. pkg-name " is already up-to-date!")}
                    :Downgrade
                    {:past-tense "downgraded"
                     :compare #(> $1 $2)
		     :already (.. pkg-name " is already old enough!")})]
    (if (list.empty? ipkg-strings)
      (print (.. "Don't have a version of "
                 pkg-name
                 " to be "
                 up-or-down.past-tense
                 "!"))
      (let [ipkgs (iter.filter-map
                   (fn [p]
                     (let [ipkg-str (list.last (str.split p "/"))
                           just-name (list.last
                                      (str.split ipkg-str "/"))
                           ipkg (parse-installed just-name)]
                       (if (not
                            (or
                             (up-or-down.compare
                              pkg-version
                              ipkg.version)
                             (= pkg-version
                                ipkg.version)))
                         ipkg)))
                   ipkg-strings)]
        (if (list.empty? ipkgs)
          (print up-or-down.already)
          (= (length ipkgs) 1)
          (tbl.merge matched {:ipkg (list.car ipkgs)})
          (let [selection (multiple-n-grade-options pkg-name ipkgs)]
            (if selection
                (tbl.merge matched {:ipkg selection}))))))))

(fn check-if-downloaded [file-name output-dir]
  (let [pipe (io.popen (.. "ls " output-dir))
        pipe-data (pipe:read "*a")
        pkg-list (str.split pipe-data "\n")]
    (pipe:close)
    (var file? false)
    (var sha? false)
    (each [x v (ipairs pkg-list)]
          (if (= v file-name)
              (set file? true)
              (= v (.. file-name ".sha256"))
              (set sha? true)))
    [file? sha?]))

;; Method :: {:Install :Upgrade :Downgrade :Fetch}
;; fetch-packages!
;; :: List ( String )
;; -> Method
;; -> Either (List String, Nil)
;; -> Either String Nil
;; -> IO ()
(fn fetch-packages! [pkg-names method only-repos out-dir force? search-type]
  "Install or upgrade PKG-NAMES with command selected by METHOD. Optionally,
from only ONLY-REPOS and, if you want to save the tlz and sha256 files in
a different location, OUT-DIR. If FORCE?, redownload."
  (let [output-dir (if out-dir
                     (if (string.find out-dir "/" -1)
                       out-dir
                       (.. out-dir "/"))
                     var/cache/qire)
        qi-cmd (match method
                 :Install "qi install "
                 :Upgrade "qi upgrade "
                 :Downgrade "qi upgrade "
                 :Fetch (..
                         "echo Saved package to "
                         (if
                           output-dir
                           output-dir))
                 _ "qi install ")
        config (read-config only-repos)
        pkgs (if (= search-type :category)
                 (let [name (list.car pkg-names)
                       matches (try-all-repos
                                 config
                                 (partial search-repos name :category))]
                   (if (not matches)
                       []
                       (list.empty? matches)
                       (do (print (.. "Found no packages in category: " name))
                           [])
                       (= method :Install)
                       (iter.filter-map
                        (fn [matched]
                          (let [pkg-list (str.split matched.pkg "_")
                                pkg-name (list.car pkg-list)
                                pkg-version (list.cadr pkg-list)
                                ipkgs (iter.filter
                                        (fn [p]
                                          (let [ipkg-str (list.last (str.split p "/"))
                                                just-name (list.last
                                                            (str.split ipkg-str "/"))
                                                ipkg (parse-installed just-name)]
                                            (= pkg-version
                                               ipkg.version)))
                                        (search-installed pkg-name :exact))]
                            (if (or force? (list.empty? ipkgs))
                              matched
                              (print (.. "You already have "
                                         pkg-name
                                         " installed, ignoring.")))))
                        matches)
                       (or (= method :Upgrade) (= method :Downgrade))
                       (iter.filter-map
                        (fn [matched]
                            (n-grade-logic method matched))
                        matches)
                       matches))
                 (iter.filter-map
                  (fn [name]
                      (let [matches (try-all-repos
                                      config
                                      (partial search-repos name :exact))
                            matched (if (not matches)
                                        nil
                                        (list.empty? matches)
                                        (print (.. "Found no packages with query: " name))
                                        (= 1 (length matches))
                                        (. matches 1)
                                        (select-match name matches))]
                        (if (not matched)
                            nil
                            (= method :Install)
                            (let [pkg-list (str.split matched.pkg "_")
                                  pkg-name (list.car pkg-list)
                                  pkg-version (list.cadr pkg-list)
                                  ipkgs (iter.filter
                                          (fn [p]
                                              (let [ipkg-str (list.last (str.split p "/"))
                                                    just-name (list.last
                                                                (str.split ipkg-str "/"))
                                                    ipkg (parse-installed just-name)]
                                                (= pkg-version
                                                   ipkg.version)))
                                          (search-installed pkg-name :exact))]
                              (if (or force? (list.empty? ipkgs))
                                  matched
                                  (print (.. "You already have "
                                             pkg-name
                                             " installed!"))))
                            (or (= method :Upgrade) (= method :Downgrade))
                            (n-grade-logic method matched)
                            matched)))
                  pkg-names))]
    (if (list.empty? pkgs)
      nil
      (let [files (iter.map
                   (fn [pkg]
                     (tbl.merge
                      (generate-path pkg config method)
                      pkg))
                   pkgs)]
        (io.write
         (..
          method
          " the above package(s)? [Y/n]: "))
        (io.flush)
        (when (tbl.find (io.read 1) ["Y" "y" "\n"])
          (each [k file (ipairs files)]
            (let [file-name file.tlz
                  url file.url
                  [file? sha?] (check-if-downloaded file-name output-dir)]
              (when (or (not sha?) (not file?) force?)
                (print
                 (..
                  "Downloading "
                  file-name
                  "...\n")))
              (if (and (not force?) sha?)
                  (do (print (.. (.. file-name ".sha256") " already fetched. Use -f to refetch."))
                      (os.execute (.. "mv "
                                      var/cache/qire
                                      file-name
                                      ".sha256"
                                      " .")))
                (wget!
                 (.. url ".sha256")
                 (.. file-name ".sha256")))
              (if (and (not force?) file?)
                  (do (print (.. file-name " already fetched. Use -f to refetch."))
                      (os.execute (.. "mv "
                                      var/cache/qire
                                      file-name
                                      " .")))
                (wget! url file-name))
              (let [cmd (.. "sha256sum -c "
                            file-name
                            ".sha256")
                    pipe (io.popen cmd)
                    pipe-data (pipe:read "*a")]
                (pipe:close)
                (if (string.find pipe-data "OK")
                  (do (os.execute (.. qi-cmd file-name))
                      (if (not (= "./" output-dir))
                        (os.execute (.. "mv "
                                        file-name
                                        " "
                                        file-name
                                        ".sha256"
                                        " "
                                        output-dir))))
                  (print "Failed sha256 checksum!"))))))))))

(fn fetch-info-installed! [name]
  (let [ipkg-string (list.car (search-installed name :exact))]
    (if ipkg-string
      (let [pkg (list.last (str.split ipkg-string "/"))
            file (io.open (.. graft-pkg-path pkg "/var/lib/qi/" pkg ".txt") "r")
            data (file:read "*a")]
        (file:close)
        (let [lines (str.split data "\n\n")
              desc (iter.reduce
                    (fn [acc elem]
                      (.. acc (str.drop elem 3) "\n"))
                    ""
                    (str.split (. lines 1) "\n"))
              pkgname (info-property data "pkgname")
              pkgversion (info-property data "pkgversion")
              below-pkgname (. (str.split data (.. "pkgname=" pkgname)) 2)
              arch (info-property below-pkgname "arch")
              release (info-property data "release")
              cat (info-property below-pkgname "pkgcategory")
              homepage (info-property data "homepage")
              license (info-property data "license")]
          (print
           (.. desc
               "Package Name: " pkgname "\n"
               "Version: " pkgversion "\n"
               "Architecture: " arch "\n"
               "Release Number: " release "\n"
               "Category: " cat "\n"
               "License(s): " license "\n"
               "Homepage: " homepage)))))))

(fn fetch-info! [name only-repos]
  (let [config (read-config only-repos)
        pkg (let [matches (try-all-repos
                           config
                           (partial search-repos name :exact))]
              (if (or (not matches)
                      (list.empty? matches))
                nil
                (= 1 (length matches))
                (. matches 1)
                (select-match name matches)))]
    (when pkg
      (let [file (generate-path pkg config)]
        (print "Fetching information...")
        (let [url (.. file.url ".txt")
              data (wget! url)
              lines (str.split data "\n\n")
              desc (iter.reduce
                    (fn [acc elem]
                      (.. acc (str.drop elem 3) "\n"))
                    ""
                    (str.split (. lines 1) "\n"))
              pkgname (info-property data "pkgname")
              pkgversion (info-property data "pkgversion")
              below-pkgname (. (str.split data (.. "pkgname=" pkgname)) 2)
              arch (info-property below-pkgname "arch")
              release (info-property data "release")
              cat (info-property below-pkgname "pkgcategory")
              homepage (info-property data "homepage")
              license (info-property data "license")]
          (print
           (.. desc
               "Package Name: " pkgname "\n"
               "Version: " pkgversion "\n"
               "Architecture: " arch "\n"
               "Release Number: " release "\n"
               "Category: " cat "\n"
               "License(s): " license "\n"
               "Homepage: " homepage "\n"
               "Repository: <" pkg.repo-id ">")))))))

(fn clear-cache! []
  (os.execute (.. "rm -f " var/cache/qire "*"))
  (print "Cache cleared!"))

(fn qi [method paths-to-tlzs]
  (let [cmd (match method
              :Install "qi install "
              :Upgrade "qi upgrade "
              "qi install")]
    (each [v pkg (ipairs paths-to-tlzs)]
      (os.execute (.. cmd pkg)))))

(fn read-args [args]
  "Accepts the full table of arguments and returns the each options with their
  arguments in a table as such: `{:-r [\"dragora-noarch\"] :-i [\"qi\"]}` "
  (var arg-table {})
  (var current nil)
  (var current-single nil)
  (each [k v (pairs args)]
    (when (> k 0)
      (let [multi-cmd? (tbl.find v many-options)
            single-cmd? (tbl.find v single-options)
            no-cmd? (tbl.find v no-options)]
        (if multi-cmd?
          (do (tset arg-table v [])
              (set current v))
          current-single
          (do (tset arg-table current-single [v])
              (set current-single nil))
          (and single-cmd? current)
          (set current-single v)
          single-cmd?
          (do (tset arg-table v [])
              (set current v))
          no-cmd?
          (tset arg-table v [])
          current
          (tset arg-table current (list.append (. arg-table current) [v]))))))
  arg-table)

(fn main [args]
  (let [args-table (read-args args)
        repos (or args-table.-r args-table.--repo)
        dir? (or args-table.-o args-table.--output-directory)
        dir (if dir? (list.car dir?))
        local? (or args-table.-l args-table.--local)
        force? (or args-table.-f args-table.--force)
        cat? (or args-table.-c args-table.--category)
        cat (if cat? (list.car cat?))]

    (match args-table
      {:install pkgs} (if cat
                        (if local?
                            (print "Error 3: Invalid command!")
                            (fetch-packages! [cat] :Install repos dir force? :category))
                        (if local?
                            (qi :Install pkgs)
                            (fetch-packages! pkgs :Install repos dir force? :exact)))

      {:upgrade pkgs?} (if cat
                        (if local?
                            (print "Error 3: Invalid command!")
                            (fetch-packages! [cat] :Upgrade repos dir force? :category))
                        (if local?
                            (qi :Upgrade pkgs)
                            (if pkgs
                                (fetch-packages! pkgs :Upgrade repos dir force? :exact)
                                (let [pkgz (search-installed nil :exact)
                                      just-pkg-names (iter.map
                                                       (fn [p]
                                                           (let [g graft-pkg-path
                                                                 just-pkg (str.split p g)]
                                                             (print (view just-pkg))
                                                             (. (str.split (. just-pkg 2) "_") 1)))
                                                       pkgz)]
                                  ;; TODO: `list.unique` may run slow, needs tested on
                                  ;; real system.
                                  (fetch-packages! (list.unique just-pkg-names)
                                                   :Upgrade
                                                   repos
                                                   dir
                                                   force?
                                                   :exact)))))

      {:downgrade pkgs} (if cat
                          (if local?
                              (print "Error 3: Invalid command!")
                              (fetch-packages! [cat] :Downgrade repos dir force? :category))
                          (if local?
                              (qi :Downgrade pkgs)
                              (fetch-packages! pkgs :Downgrade repos dir force? :exact)))

      {:info pkgs} (if local?
                     (fetch-info-installed! (. pkgs 1))
                     (fetch-info! (. pkgs 1) repos))

      {:search pkgs} (if cat
                         (if local?
                             (search-installed! cat :category)
                             (search-repos! cat repos :category))
                         (if local?
                             (if pkgs
                                 (search-installed! (. pkgs 1) :lazy)
                                 (search-installed! nil :lazy))
                             (if pkgs
                                 (search-repos! (. pkgs 1) repos)
                                 (search-repos! nil repos))))

      {:fetch pkgs} (fetch-packages! pkgs :Fetch repos dir)

      {:sync only-repos} (sync-repos! only-repos)

      {:build-index only-repos} (build-index! only-repos dir)

      {:remove pkgs} (if cat
                       (remove-packages! [cat] :category)
                       (remove-packages! pkgs :exact))

      {:clean a?} (clear-cache!)

      {:version a?} (print version)
      {:--version a?} (print version)

      {:help a?} (print help-text)
      {:--help a?} (print help-text)

      _ (print "Unknown command. Try --help for more information!"))))

(main arg)
